home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / demos / mainform.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  14.5 KB  |  538 lines
  1. { FormulaBuilder 1.0 }
  2. { YGB Software, Inc. }
  3. { Copyright 1995 Clayton Collie }
  4. { All Rights Reserved           }
  5.  
  6. {* Main Form of the main FormulaBuilder Demo *}
  7.  
  8. unit Mainform;
  9. interface
  10. uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  12.   Forms, Dialogs, TabNotBk, StdCtrls, Buttons, ExtCtrls, DB,
  13.   DBTables, Grids, DBGrids,DBCtrls,
  14.   FBCalc,FBComp,FBDBComp,
  15.   FiltrFrm,FuncDlg,extfunc,
  16.   DBExprFm, VBXCtrl, Chart2fx, Outline,
  17.   fb_rtti,FBRTCOMP;
  18.  
  19. type
  20.   TMainDemoFm = class(TForm)
  21.     Notebook: TTabbedNotebook;
  22.     ResultsPanel: TPanel;
  23.     Panel1: TPanel;
  24.     ExpressionListbox: TListBox;
  25.     Panel2: TPanel;
  26.     btnFunctions: TBitBtn;
  27.     CancelBtn: TBitBtn;
  28.     SpeedButton2: TSpeedButton;
  29.     CustomerGrid: TDBGrid;
  30.     CustomerTable: TTable;
  31.     CustomerDataSource: TDataSource;
  32.     Panel5: TPanel;
  33.     OrdersGrid: TDBGrid;
  34.     OrdersTable: TTable;
  35.     OrdersDataSource: TDataSource;
  36.     Panel8: TPanel;
  37.     OrdersResultPanel: TPanel;
  38.     Panel9: TPanel;
  39.     cbxApplyCustomerFilter: TCheckBox;
  40.     OrdersTableOrderNo: TFloatField;
  41.     OrdersTableCustNo: TFloatField;
  42.     OrdersTableSaleDate: TDateTimeField;
  43.     OrdersTableShipDate: TDateTimeField;
  44.     OrdersTableEmpNo: TIntegerField;
  45.     OrdersTableTerms: TStringField;
  46.     OrdersTablePaymentMethod: TStringField;
  47.     OrdersTableItemsTotal: TCurrencyField;
  48.     OrdersTableTaxRate: TFloatField;
  49.     OrdersTableFreight: TCurrencyField;
  50.     OrdersTableAmountPaid: TCurrencyField;
  51.     btnCustomerFilter: TBitBtn;
  52.     btnOrdersFilter: TBitBtn;
  53.     cbxApplyOrdersFilter: TCheckBox;
  54.     Formula: TBitBtn;
  55.     ChartFX1: TChartFX;
  56.     GroupBox1: TGroupBox;
  57.     ResultMemo: TMemo;
  58.     ExpressionGroupBox: TGroupBox;
  59.     ExpressionCombo: TComboBox;
  60.     VariablesBtn: TSpeedButton;
  61.     CalcBtn: TSpeedButton;
  62.     Panel3: TPanel;
  63.     FormulaEdit: TEdit;
  64.     XMinEdit: TEdit;
  65.     XMaxEdit: TEdit;
  66.     NumPtsEdit: TEdit;
  67.     btnDrawGraph: TSpeedButton;
  68.     Label1: TLabel;
  69.     Label2: TLabel;
  70.     Label3: TLabel;
  71.     Label4: TLabel;
  72.     newFuncsCombo: TComboBox;
  73.     NewFuncsListbox: TListBox;
  74.     RunBtn: TSpeedButton;
  75.     runmemo: TMemo;
  76.     RegisterFuncBtn: TBitBtn;
  77.     UnregisterBtn: TBitBtn;
  78.     HelpBtn: TBitBtn;
  79.     btnAbout: TSpeedButton;
  80.     Bevel1: TBevel;
  81.     SimpleExpression: TExpression;
  82.     CustomersFilter: TDSFilter;
  83.     OrdersFilter: TDSFilter;
  84.     OrdersExpression: TDBExpression;
  85.     lblCustomerGrid: TLabel;
  86.     lblOrdersGrid: TLabel;
  87.     CustomerTableCustNo: TFloatField;
  88.     CustomerTableCompany: TStringField;
  89.     CustomerTableAddr1: TStringField;
  90.     CustomerTableCity: TStringField;
  91.     CustomerTableState: TStringField;
  92.     CustomerTableZip: TStringField;
  93.     CustomerTableCountry: TStringField;
  94.     CustomerTablePhone: TStringField;
  95.     CustomerTableFAX: TStringField;
  96.     CustomerTableTaxRate: TFloatField;
  97.     CustomerTableContact: TStringField;
  98.     CustomerTableLastInvoiceDate: TDateTimeField;
  99.     lblDemo: TLabel;
  100.     BitBtn1: TBitBtn;
  101.     Panel4: TPanel;
  102.     Panel6: TPanel;
  103.     Memo2: TMemo;
  104.     MainLabel: TLabel;
  105.     procedure btnFunctionsClick(Sender: TObject);
  106.     procedure FormCreate(Sender: TObject);
  107.     procedure FilterBtnClick(Sender: TObject);
  108.     procedure btnOrdersFilterClick(Sender: TObject);
  109.     procedure cbxApplyCustomerFilterClick(Sender: TObject);
  110.     procedure FormulaClick(Sender: TObject);
  111.     procedure CustomerDataSourceDataChange(Sender: TObject; Field: TField);
  112.     procedure OrdersDataSourceDataChange(Sender: TObject; Field: TField);
  113.     procedure cbxApplyOrdersFilterClick(Sender: TObject);
  114.     procedure CalcBtnClick(Sender: TObject);
  115.     procedure VariablesBtnClick(Sender: TObject);
  116.     procedure ExpressionListboxDblClick(Sender: TObject);
  117.     procedure btnDrawGraphClick(Sender: TObject);
  118.     procedure RegisterFuncBtnClick(Sender: TObject);
  119.     procedure UnregisterBtnClick(Sender: TObject);
  120.     procedure RunBtnClick(Sender: TObject);
  121.     procedure NewFuncsListboxClick(Sender: TObject);
  122.     procedure HelpBtnClick(Sender: TObject);
  123.     procedure btnAboutClick(Sender: TObject);
  124.     procedure BitBtn1Click(Sender: TObject);
  125.   private
  126.     { Private declarations }
  127.     { Page 1 - Filter and DBExpression Demo }
  128.     Xmax,XMin                 : double;
  129.     OldNumpts,NumPts          : longint;
  130.     GraphFormula              : string[150];
  131.     Function  CollectGraphOpts : boolean;
  132.     Procedure PlotGraph;
  133.     Procedure UpdateCustomerGrid;
  134.     Procedure UpdateOrdersGrid;
  135.     Procedure UpdateOrderCalc;
  136.     Procedure RunFunc;
  137.     { RTTI }
  138.   public
  139.     { Public declarations }
  140.   end;
  141.  
  142. var
  143.   MainDemoFm: TMainDemoFm;
  144.  
  145. implementation
  146. uses FBMisc,VarDlg,ChartFX,FBHelpFm,demabout,typinfo,WarnDlg,RTTIFm;
  147. {$R *.DFM}
  148.  
  149. Const ALLTYPES = [vtSTRING,vtINTEGER,vtFLOAT,vtBOOLEAN,vtDATE,vtCHAR,vtANY];
  150. const DBExpr =
  151. '[Customer->Company] + " paid $"+str([Orders->AmountPaid],2) + '+
  152. '" on order #"+Str([Orders->OrderNo])+ " on " + '+
  153. 'DateToStr([Orders->SaleDate])+". Payment was by " + '+
  154.                '[Orders->PaymentMethod]';
  155.  
  156.       CustExpr = 'Company + " is in " +City+" " +State+" "+Zip';
  157.  
  158.       OrderExpr = '"Customer #"+Str(CustNo)+" Owes $"+str(ItemsTotal-AmountPaid,2) + '+
  159.                   '" on Order # "+Str(OrderNo)';
  160.  
  161.  
  162. Function RemoveCRLF(const s : string):string;
  163. var a,b : string;
  164. begin
  165.   SplitByDelim(s,#13#10,a, b);
  166.   result := a + b;
  167. end;
  168.  
  169.  
  170. procedure TMainDemoFm.btnFunctionsClick(Sender: TObject);
  171. begin
  172.    DisplayFunctionList;
  173. end;
  174.  
  175. procedure TMainDemoFm.FormCreate(Sender: TObject);
  176. var proplist : TStringList;
  177. begin
  178.    CustomerTable.Active := True;  { Do this only on enter page 1 ?}
  179.    OrdersTable.Active   := True;
  180.    {::::::}
  181.    OrdersExpression.Database := OrdersTable.Database;
  182.    OrdersExpression.Formula  := DBExpr;
  183.    { UpdateOrderCalc }
  184.    RunBtn.Enabled := False;
  185.  end;
  186.  
  187.  
  188.  
  189. {/%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
  190. { Page 1 - Basic Demo                                                  }
  191. {::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
  192.  
  193. procedure TMainDemoFm.CalcBtnClick(Sender: TObject);
  194. var s: String;
  195.  
  196.       Procedure DispError;
  197.       begin
  198.         ResultMemo.Text := SimpleExpression.StatusText;
  199.         MessageBeep(MB_ICONHAND);
  200.       end;
  201.  
  202. begin
  203.    s := ExpressionCombo.Text;
  204.    if (s[1] = ';') OR (s = '') then exit;  { ignore comments and blank lines }
  205.    with simpleExpression do
  206.    begin
  207.      Formula := S;
  208.      if Status = EXPR_SUCCESS then
  209.      begin
  210.        ResultMemo.Text := AsString;
  211.        if Status = EXPR_SUCCESS then
  212.           ExpressionCombo.Items.Add(s)
  213.         else
  214.           DispError;
  215.      end
  216.     else
  217.       DispError;
  218.    end;
  219. end;
  220.  
  221.  
  222. procedure TMainDemoFm.VariablesBtnClick(Sender: TObject);
  223. begin
  224.    ManageVariables(SimpleExpression.Handle);
  225. end;
  226.  
  227. procedure TMainDemoFm.ExpressionListboxDblClick(Sender: TObject);
  228. var s : string;
  229. begin
  230.    with ExpressionListBox do
  231.    if itemIndex > 0 then
  232.    begin
  233.      s := items[ItemIndex];
  234.      if s[1] <> ';' then
  235.         ExpressionCombo.Text := s;
  236.    end;
  237. end;
  238.  
  239.  
  240.  
  241. {*                                   *}
  242. {* Page 2 - BDE Expression Demo      *}
  243. {* Utilizes all the Data-Aware Types *}
  244. {*                                   *}
  245.  
  246. Procedure TMainDemoFm.UpdateCustomerGrid;
  247. begin
  248.   CustomersFilter.Refresh;
  249.   CustomerGrid.Invalidate; 
  250.   CustomerTable.First;
  251. end;
  252.  
  253. Procedure TMainDemoFm.UpdateOrdersGrid;
  254. begin
  255.   OrdersFilter.Refresh;
  256.   OrdersGrid.Invalidate;
  257.   OrdersTable.First;
  258. end;
  259.  
  260. Procedure TMainDemoFm.UpdateOrderCalc;
  261. begin
  262.   if (not Assigned(OrdersExpression)) or OrdersExpression.isNull then
  263.      OrdersResultPanel.Caption := ''
  264.    else
  265.      OrdersResultPanel.Caption := ' > '+RemoveCRLF(OrdersExpression.AsString);
  266. end;
  267.  
  268.  
  269. procedure TMainDemoFm.btnOrdersFilterClick(Sender: TObject);
  270. begin
  271.   if BuildDSExpression('Orders Filter Expression',[vtBoolean],
  272.                         OrdersFilter,OrdersTable) then
  273.                         UpdateOrdersGrid;
  274. end;
  275.  
  276. procedure TMainDemoFm.FilterBtnClick(Sender: TObject);
  277. begin
  278.   if BuildDSExpression('Customer Filter Expression',[vtBOOLEAN],
  279.                        CustomersFilter,CustomerTable) then
  280.                        UpdateCustomerGrid;
  281. end;
  282.  
  283.  
  284. procedure TMainDemoFm.cbxApplyCustomerFilterClick(Sender: TObject);
  285. begin
  286.   CustomersFilter.Active := cbxApplyCustomerFilter.Checked;
  287.   UpdateCustomerGrid;
  288. end;
  289.  
  290. procedure TMainDemoFm.FormulaClick(Sender: TObject);
  291. begin
  292.   OrdersExpression.Database := CustomerTable.Database;
  293.   if BuildDBExpression('Database Expression Example',OrdersExpression) then
  294.      UpdateOrderCalc;
  295. end;
  296.  
  297. procedure TMainDemoFm.CustomerDataSourceDataChange(Sender: TObject;Field: TField);
  298. begin
  299.   UpdateOrderCalc;
  300. end;
  301.  
  302. procedure TMainDemoFm.OrdersDataSourceDataChange(Sender: TObject; Field: TField);
  303. begin
  304.    UpdateOrderCalc;
  305. end;
  306.  
  307. procedure TMainDemoFm.cbxApplyOrdersFilterClick(Sender: TObject);
  308. begin
  309.   OrdersFilter.Active := cbxApplyOrdersFilter.Checked;
  310.   UpdateOrdersGrid;
  311. end;
  312.  
  313. {*                                                *}
  314. {*          ::: Graphing Demo ::::                *}
  315. {*                                                *}
  316. {* Demonstrates a typical use of FormulaBuilder   *}
  317. {*                                                *}
  318.  
  319.  
  320. Procedure DispError(const errstr : string);
  321. begin
  322.   MessageDlg(ErrStr, mtError, [mbOK], 0);
  323. end;
  324.  
  325.  
  326. Function TMainDemoFm.CollectGraphOpts : Boolean;
  327. begin
  328.   Result := False;
  329.   try
  330.    XMin   := StrToFloat(XMinEdit.Text);
  331.    XMax   := StrToFloat(XMaxEdit.Text);
  332.    NumPts := StrToInt(NumPtsEdit.Text);
  333.    GraphFormula := FormulaEdit.Text;
  334.    if (XMax < xMin) then
  335.       DispError('Maximum less than minimum value')
  336.    else
  337.       if (numpts <= 2) then
  338.          DispError('Number of points must be >= 2 ')
  339.      else
  340.         if GraphFormula = '' then
  341.            DispError('Formula must be non blank')
  342.        else
  343.           result := true;
  344.   Except
  345.     DispError('Invalid numeric input ');
  346.     Result := False;
  347.   end;
  348. end; { CollectGraphData }
  349.  
  350.  
  351. Procedure TMainDemoFm.PlotGraph;
  352. var ydata  : Double;
  353.     xdelta : double;
  354.     xdata  : ^Double;
  355.     ymax,Ymin : double;
  356.     tmp    : double;
  357.     cnt    : integer;
  358.     ret    : byte;
  359.     GraphExpression : TExpression;
  360.     Status          : Integer;
  361.  
  362. begin
  363.   GraphExpression := TExpression.Create(NIL);
  364.   TRY
  365.       With GraphExpression do
  366.       begin
  367.         UseExceptions := True;
  368.         TRY
  369.           AddVariable('X',vtFLOAT);
  370.           Formula := GraphFormula;
  371.           ret     := GraphExpression.ReturnType;
  372.           if (ret <> vtFloat) then
  373.           begin
  374.             DispError('Floating point expression expected');
  375.             GraphExpression.Free;
  376.             exit;
  377.           end;
  378.           GetVarPtr('X',ret,pointer(XData));
  379.         EXCEPT
  380.           on EFBError do
  381.           begin
  382.              DispError(StatusText);
  383.              GraphExpression.Free;
  384.              exit;
  385.           end;
  386.         END;
  387.         UseExceptions := False;
  388.       end; {}
  389.       xdelta := (xMax - xMin)/numpts;
  390.       xmax := xmax + xdelta;
  391.       tmp  := xmin;
  392.       xmin := xmin - xdelta;
  393.       cnt  := 0;
  394.       With ChartFx1 do begin
  395.            {* Hide the Graph while we draw *}
  396.            visible := False;
  397.            OpenData[COD_VALUES]  := MAKELONG(1,NumPts);
  398.            OpenData[COD_XVALUES] := MAKELONG(1,NumPts);
  399.            Adm[CSA_XMIN]:= xmin;
  400.            Adm[CSA_XMAX]:= xmax;
  401.            thisSerie := 0;
  402.            xdata^ := tmp;
  403.            ymax   := 5.0E-320; {}
  404.            ymin   := 1.7E+308; { Double }
  405.  
  406.            {*  Populate the Graph *}
  407.  
  408.            while (xdata^ <= xMax) and (Cnt < NumPts) do
  409.            begin
  410.              ydata := GraphExpression.AsFloat;
  411.              if yData > yMax then
  412.                 yMax := yData;
  413.              if YData < yMin then
  414.                 YMin := yData;
  415.              XValue[cnt] := xData^;
  416.              Value[cnt]  := yData;
  417.              inc(Cnt);
  418.              xdata^ := xData^ + xDelta;
  419.            end;
  420.  
  421.            {* Set the Chart Titles *}
  422.  
  423.            Title[CHART_TOPTIT] := 'Graph Of : '+ GraphExpression.Formula;
  424.            Title[CHART_BOTTOMTIT] := 'X Values';
  425.            Title[CHART_LEFTTIT]   := 'Y Values';
  426.            Adm[CSA_MIN] := ymin;
  427.            Adm[CSA_MAX] := yMax;
  428.            CloseData[COD_VALUES]  := 0;
  429.            CloseData[COD_XVALUES] := 0;
  430.  
  431.            {* Show Graph Again *}
  432.            Visible := True;
  433.       end;
  434.  FINALLY
  435.   GraphExpression.Free;
  436.  END;
  437. end; { PlotGraph }
  438.  
  439.  
  440.  
  441. procedure TMainDemoFm.btnDrawGraphClick(Sender: TObject);
  442. begin
  443.   if CollectGraphOpts then PlotGraph;
  444. end;
  445.  
  446. {::::::::::::::::::}
  447. {*                                                *}
  448. {* Extensibility Demo. Allows the user to Run the *}
  449. {* functions defined in the unit EXTFUNC.PAS      *}
  450. {*                                                *}
  451. Procedure TMainDemoFM.RunFunc;
  452. var s: String;
  453.  
  454.       Procedure DispError;
  455.       begin
  456.         RunMemo.Text := SimpleExpression.StatusText;
  457.         MessageBeep(MB_ICONHAND);
  458.       end;
  459.  
  460. begin
  461.    s := NewfuncsCombo.Text;
  462.    if s <> '' then
  463.    with simpleExpression do
  464.    begin
  465.      Formula := S;
  466.      if Status = EXPR_SUCCESS then
  467.      begin
  468.        RunMemo.Text := AsString;
  469.        if Status = EXPR_SUCCESS then
  470.           newfuncsCombo.Items.Add(s)
  471.         else
  472.           DispError;
  473.      end
  474.     else
  475.       DispError;
  476.    end;
  477. end;
  478.  
  479.  
  480. procedure TMainDemoFm.RegisterFuncBtnClick(Sender: TObject);
  481. begin
  482.  EXTFUNC.RegisterFunctions;
  483.  newFuncsListBox.Enabled := true;
  484.  RegisterFuncBtn.Enabled := False;
  485.  RunBtn.Enabled := True;
  486. end;
  487.  
  488. procedure TMainDemoFm.UnregisterBtnClick(Sender: TObject);
  489. begin
  490.   EXTFUNC.UnRegisterFunctions;
  491.   newFuncsListBox.Enabled := false;
  492.   RegisterFuncBtn.Enabled := true;
  493.   RunBtn.Enabled := false;
  494. end;
  495.  
  496. procedure TMainDemoFm.RunBtnClick(Sender: TObject);
  497. begin
  498.   runfunc;
  499. end;
  500.  
  501. procedure TMainDemoFm.NewFuncsListboxClick(Sender: TObject);
  502. begin
  503.  With NewFuncsListbox do
  504.     NewFuncsCombo.Text := Items[ItemIndex];
  505. end;
  506.  
  507. procedure TMainDemoFm.HelpBtnClick(Sender: TObject);
  508. begin
  509.    DisplayHelp(Notebook.PageIndex);
  510. end;
  511.  
  512. procedure TMainDemoFm.btnAboutClick(Sender: TObject);
  513. begin
  514.    DisplayAbout;
  515. end;
  516.  
  517. { RTTI Demo Page }
  518.  
  519. Function RemoveSpaces(const s : String):string;
  520. var i : integer;
  521. begin
  522.   result := '';
  523.   for i := 1 to length(s) do begin
  524.       if not(s[i] in [#32,#160]) then
  525.          result := result + s[i];
  526.   end;
  527. end;
  528.  
  529.  
  530.  
  531. procedure TMainDemoFm.BitBtn1Click(Sender: TObject);
  532. begin
  533.   if ShowDelayWarning = mrOk then
  534.      ShowRTTIDemo;
  535. end;
  536.  
  537. end.
  538.